Question

我有一些TC（自定义组件），并在重新绘制时我在卡片上绘制了一些文本。在底部和顶部使用相同的组件。但是，当我绘制文本时，底部TCards为文本添加了白色背景..而顶部的标记不是..我不确定这是在做什么或为什么。 enter image description here 他们都使用相同的油漆..

好的，我首先添加底卡。

/shows the form and sets up the cards.
procedure TFGame.FormShow(Sender: TObject);
var i: integer;
num : TValue;
db: widestring;
begin
  Maindir := label1.Caption;   //sets main dir
   db:= maindir;
   waitingforatarget := false;

  //Sets all oponents cards.
  OCardRed.background.loadfromfile(Maindir+'\pics\backcard.jpg');
  //..........


  //sets yoru cards
  Cardlava1.background.loadfromfile(Maindir+'\pics\backcard.jpg');
  Cardlava1.Repaint;
  //....

    getstartingcards;
  end;

getstartingcards ..

// gets all your starting cards and puts them into the corret rows.
procedure TFGame.GetStartingCards;
const
  ManaTypes : array [0..3] of string = ('Lava','Water','Dark','Nature');
var
   i: integer;
   z:integer;
   Cards: TObjectList<Tcard>;
begin
   // showmessage('list being created');
  Cards := TObjectList<TCard>.Create;
  z:=0;
  // add all tcards (Desgin ) to this list in order Lava,water,dark,nature
  cards.Add(cardLava1);
  cards.Add(cardlava2);
  cards.Add(cardlava3);
  cards.Add(cardlava4);
  cards.Add(cardwater1);
  cards.Add(cardwater2);
  cards.Add(cardwater3);
  cards.Add(cardwater4);
  cards.Add(carddark1);
  cards.Add(carddark2);
  cards.Add(carddark3);
  cards.Add(carddark4);
  cards.Add(cardnature1);
  cards.Add(cardnature2);
  cards.Add(cardnature3);
  cards.Add(cardnature4);
 //get data from DB
  for i := 0 to Length(ManaTypes) - 1 do
  begin
   // showmessage('getting manna types');
    with adoquery1 do
    begin
      close;
      sql.Clear;
      sql.Add('SELECT TOP 4 * FROM Cards WHERE Color = "'+ManaTypes[i]+'" ORDER BY Rnd(-(1000*ID)*Time())');
      open;
    end;

 //return the result of everything for giving mana type..
     if adoquery1.RecordCount = 0 then
        Showmessage('Error no cards in db');
     adoquery1.First;

     while not adoquery1.Eof do
     begin
        ///showmessage('writeing query to card '+inttostr(z));
        cards[z].Cname := adoquery1.FieldByName('Name').AsString;
        cards[z].Ccost := adoquery1.Fieldbyname('Cost').AsInteger;
        cards[z].Ctext := adoquery1.FieldByName('Text').AsString;
        cards[z].Ccolor := adoquery1.FieldByName('Color').AsString;
        cards[z].Cinplay := false; //in the play area
        if adoquery1.fieldbyname('Power').asstring <> '' then
            cards[z].Cpower := adoquery1.FieldByName('Power').AsInteger;
        if adoquery1.fieldbyname('Def').asstring <> '' then
            cards[z].Cdef := adoquery1.FieldByName('Def').AsInteger;
        if adoquery1.FieldByName('Type').AsString = 'Spell' then
           cards[z].Cspell := true
        else
           cards[z].Cspell := false;
        if adoquery1.FieldByName('Target').AsString = 'yes' then
            cards[z].SetTargetTrue
        else
            cards[z].settargetfalse;


        //based on color change background
        if cards[z].Ccolor = 'Lava' then
           cards[z].Background.loadfromfile(maindir+'\pics\lava.png');
        if cards[z].Ccolor = 'Water' then
           cards[z].Background.loadfromfile(maindir+'\pics\water.png');
        if cards[z].Ccolor = 'Dark' then
           cards[z].Background.loadfromfile(maindir+'\pics\dark.png');
        if cards[z].Ccolor = 'Nature' then
           cards[z].Background.loadfromfile(maindir+'\pics\nature.png');
       adoquery1.Next;
       cards[z].repaint;
       z:=z+1;
     end;
  end;
end;

显示底部的卡片 TCard重绘如下..

{TCard paint procedure}
//------------------------------------------------------------
procedure Tcard.Paint;
//------------------------------------------------------------
  begin
    Canvas.StretchDraw(ClientRect, FBackground.Graphic);
    if FBackground.Graphic = nil then
      begin
        Canvas.Brush.Style := bsClear;
        Canvas.Pen.Style := psDash;
        Canvas.Rectangle(ClientRect);
      end ;
    if (FBackground.Graphic <> nil) and (ownercard = false) then
     begin
      if (CSpell = false) then
       begin
         SetLpower(inttostr(CPower));   //if monster card
         SetLDefence(inttostr(CDef));  //if monster card
       end;
      SetLCost(inttostr(CCost));
      setLText(CText);
     end;
  end;

所有数字的绘图都是这样的..这个是中心数，但都是相同的

{Sets and draws the cost to the TCard}
//-------------------------------------------------------------
procedure TCard.SetLCost(value :string); //cost
//-------------------------------------------------------------
  begin
  if fbigcard = false then
    begin
     canvas.font.size := 8;
     Canvas.textout(19,1,inttostr(CCost));
    end
  else
    begin
     canvas.font.size := 12;
     canvas.font.color := TColor($FFFFFF);
     Canvas.textout(65,7,inttostr(CCost));
     canvas.Font.Color := CLBlack;
    end;
  end;

我认为这就是所有的代码..如果你需要我缺少的东西，请告诉我谢谢格伦

Answer 1

在您的组件的Paint()方法中，在绘制文字之前，请设置Canvas.Brush.Style := bsClear，或直接致电SetBkMode(Canvas.Handle, TRANSPARENT)。如果没有背景图形，您目前只设置Brush.Style，但如果有背景图形，则会绘制所有文本。

顺便说一句，单独测试Graphic <> nil并不足以检查是否指定了背景。您还需要在Graphic.Empty时检查Graphic <> nil。

请改为尝试：

procedure Tcard.Paint;
begin
  Canvas.Brush.Style := bsClear;

  if (FBackground.Graphic <> nil) and (not FBackground.Graphic.Empty) then
  begin
    Canvas.StretchDraw(ClientRect, FBackground.Graphic);
  end else
  begin
    Canvas.Pen.Style := psDash;
    Canvas.Rectangle(ClientRect);
  end;

  if (not ownercard) then
  begin
    if (not CSpell) then
    begin
      SetLpower(IntToStr(CPower));   //if monster card
      SetLDefence(IntToStr(CDef));  //if monster card
    end;
    SetLCost(IntToStr(CCost));
    SetLText(CText);
  end;
end;

如何删除文本背景？

1 个答案: