× CodeTyphon MS Windows (XP, Vista, Win7, Win8.x and Win10) OS Development, discussions and problems

Question StringGrid component does not show cyrillic strings correctly

  • Droid c3p0
  • Droid c3p0's Avatar Topic Author
  • Offline
  • New Member
  • New Member
More
2 months 2 weeks ago - 2 months 2 weeks ago #16823 by Droid c3p0
After I coverted a Delphi project to Lazarus project this StringGrid do show cyrillic strings as they have to be readable by bulgarian language. 
I did copy the Lazarus project for CT project: 
 - First Form do show every cyrillic strings correctly; 
 - Second Form by mentioned StringGrid does not show cyrillic strings correctly; 
 - Third Form do show every cyrillic strings correctly; 
Font
CharSet         RUSSIAN_CHARSET
Color           clBlack
Height          -15
Name            Tahoma
Orientation     0
Pitch           fpVariable
Quality         Draft
Size            11
Style           []
Is there any way to solve above problem with the StringGrid ?
Last edit: 2 months 2 weeks ago by Droid c3p0.

Please Log in or Create an account to join the conversation.

  • Matis A.
  • Matis A.'s Avatar
  • Away
  • Moderator
  • Moderator
More
2 months 2 weeks ago #16824 by Matis A.
Without a test project,
I can't give any suggestion.

PilotLogic Core Programmer

Please Log in or Create an account to join the conversation.

  • Droid c3p0
  • Droid c3p0's Avatar Topic Author
  • Offline
  • New Member
  • New Member
More
2 months 2 weeks ago - 2 months 2 weeks ago #16825 by Droid c3p0
▼ File: FinchCT.ctpr
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
  <ProjectOptions>
    <Version Value="12"/>
    <PathDelim Value="\"/>
    <General>
      <SessionStorage Value="InProjectDir"/>
      <Title Value="FinchCT"/>
      <Scaled Value="True"/>
      <ResourceType Value="res"/>
      <UseXPManifest Value="True"/>
      <XPManifest>
        <DpiAware Value="True"/>
        <AnsiUTF8 Value="True"/>
        <UseCompatibility Value="True"/>
        <UseCompatibilityVista Value="True"/>
        <UseCompatibilityWin7 Value="True"/>
        <UseCompatibilityWin8 Value="True"/>
        <UseCompatibilityWin81 Value="True"/>
        <UseCompatibilityWin10 Value="True"/>
        <UseCompatibilityWin11 Value="True"/>
      </XPManifest>
    </General>
    <BuildModes>
      <Item Name="Default" Default="True"/>
      <SharedMatrixOptions Count="1">
        <Item1 ID="210959794584" Modes="Default" Value="-dDisableUTF8RTL"/>
      </SharedMatrixOptions>
    </BuildModes>
    <PublishOptions>
      <Version Value="2"/>
      <UseFileFilters Value="True"/>
    </PublishOptions>
    <RunParams>
      <FormatVersion Value="2"/>
    </RunParams>
    <RequiredPackages>
      <Item>
        <PackageName Value="adLCL"/>
      </Item>
    </RequiredPackages>
    <Units>
      <Unit>
        <Filename Value="FinchCT.ppr"/>
        <FRMtype Value="0"/>
        <IsPartOfProject Value="True"/>
      </Unit>
      <Unit>
        <Filename Value="quest.pas"/>
        <FRMtype Value="200"/>
        <IsPartOfProject Value="True"/>
        <ComponentName Value="Form_Quest"/>
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
        <UnitName Value="Quest"/>
      </Unit>
      <Unit>
        <Filename Value="shape.pas"/>
        <FRMtype Value="200"/>
        <IsPartOfProject Value="True"/>
        <ComponentName Value="Form_Shape"/>
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
        <UnitName Value="Shape"/>
      </Unit>
      <Unit>
        <Filename Value="about.pas"/>
        <FRMtype Value="200"/>
        <IsPartOfProject Value="True"/>
        <ComponentName Value="Form_About"/>
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
        <UnitName Value="About"/>
      </Unit>
    </Units>
  </ProjectOptions>
  <CompilerOptions>
    <Version Value="11"/>
    <PathDelim Value="\"/>
    <Target>
      <Filename Value="FinchCT"/>
    </Target>
    <SearchPaths>
      <IncludeFiles Value="$(ProjOutDir)"/>
      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
    </SearchPaths>
    <Linking>
      <Options>
        <Win32>
          <GraphicApplication Value="True"/>
        </Win32>
      </Options>
    </Linking>
  </CompilerOptions>
  <Debugging>
    <Exceptions>
      <Item>
        <Name Value="EAbort"/>
      </Item>
      <Item>
        <Name Value="ECodetoolError"/>
      </Item>
      <Item>
        <Name Value="EFOpenError"/>
      </Item>
    </Exceptions>
  </Debugging>
</CONFIG>
▼ File: FinchCT.ctps
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
  <ProjectSession>
    <PathDelim Value="\"/>
    <Version Value="12"/>
    <BuildModes Active="Default"/>
    <Units>
      <Unit>
        <Filename Value="FinchCT.ppr"/>
        <FRMtype Value="0"/>
        <IsPartOfProject Value="True"/>
        <EditorIndex Value="0"/>
        <WindowIndex Value="0"/>
        <CursorPos Y="26"/>
        <UsageCount Value="28"/>
        <Loaded Value="True"/>
      </Unit>
      <Unit>
        <Filename Value="quest.pas"/>
        <FRMtype Value="200"/>
        <IsPartOfProject Value="True"/>
        <ComponentName Value="Form_Quest"/>
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
        <UnitName Value="Quest"/>
        <EditorIndex Value="1"/>
        <WindowIndex Value="0"/>
        <TopLine Value="1377"/>
        <CursorPos Y="1398"/>
        <UsageCount Value="28"/>
        <Loaded Value="True"/>
        <LoadedDesigner Value="True"/>
      </Unit>
      <Unit>
        <Filename Value="shape.pas"/>
        <FRMtype Value="200"/>
        <IsPartOfProject Value="True"/>
        <ComponentName Value="Form_Shape"/>
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
        <UnitName Value="Shape"/>
        <IsVisibleTab Value="True"/>
        <EditorIndex Value="2"/>
        <WindowIndex Value="0"/>
        <TopLine Value="3"/>
        <UsageCount Value="28"/>
        <Loaded Value="True"/>
        <LoadedDesigner Value="True"/>
      </Unit>
      <Unit>
        <Filename Value="about.pas"/>
        <FRMtype Value="200"/>
        <IsPartOfProject Value="True"/>
        <ComponentName Value="Form_About"/>
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
        <UnitName Value="About"/>
        <EditorIndex Value="3"/>
        <WindowIndex Value="0"/>
        <UsageCount Value="28"/>
        <Loaded Value="True"/>
        <LoadedDesigner Value="True"/>
      </Unit>
      <Unit>
        <Filename Value="shape.frm"/>
        <FRMtype Value="0"/>
        <EditorIndex Value="-1"/>
        <WindowIndex Value="0"/>
        <TopLine Value="487"/>
        <UsageCount Value="10"/>
        <DefaultSyntaxHighlighter Value="FRM"/>
      </Unit>
    </Units>
    <JumpHistory HistoryIndex="5">
      <Position>
        <Filename Value="quest.pas"/>
      </Position>
      <Position>
        <Filename Value="shape.pas"/>
      </Position>
      <Position>
        <Filename Value="about.pas"/>
      </Position>
      <Position>
        <Filename Value="shape.pas"/>
      </Position>
      <Position>
        <Filename Value="FinchCT.ppr"/>
        <Caret Line="26"/>
      </Position>
      <Position>
        <Filename Value="shape.pas"/>
      </Position>
    </JumpHistory>
    <RunParams>
      <FormatVersion Value="2"/>
      <Modes ActiveMode=""/>
    </RunParams>
  </ProjectSession>
</CONFIG>
▼ File: FinchCT.ppr
program FinchCT;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  {$IFDEF HASAMIGA}
  athreads,
  {$ENDIF}
  Interfaces, // this includes the CT adLCL widgetset
  Forms, Quest, Shape, About
  { you can add units after this };

{$R *.res}

begin
  RequireDerivedFormResource:=True;
  Application.Scaled:=True;
  Application.Initialize;
  Application.CreateForm(TForm_Quest, Form_Quest);
  Application.CreateForm(TForm_Shape, Form_Shape);
  Application.CreateForm(TForm_About, Form_About);
  Application.Run;
end.

unit Shape;

{$MODE Delphi}

interface

uses
  Windows, SysUtils, Variants,
  Classes, Graphics, Controls, Forms, Dialogs, Grids,
  StdCtrls;

type

  { TForm_Shape }

  TForm_Shape = class(TForm)
    StrGrid_Profile: TStringGrid;
    procedure StrGrid_ShapeDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    procedure AutoSizeCol(Grid: TStringGrid; Column: integer);
    procedure AutoSizeColumns(Sender: TObject);
    { Public declarations }
  end;

var
  Form_Shape: TForm_Shape;

implementation

{$R *.frm}

uses
  Quest;

procedure TForm_Shape.FormShow(Sender: TObject);
begin
  Form_Shape.Color := Form_Quest.Color;
  Form_Shape.Font := Form_Quest.Font;
end;

procedure TForm_Shape.AutoSizeCol(Grid: TStringGrid; Column: integer);
var
  i, W, WMax: integer;
begin
  WMax := 0;
  for i := 0 to (Grid.RowCount - 1) do begin
    W := Grid.Canvas.TextWidth(Grid.Cells[Column, i]);
    if W > WMax then
      WMax := W;
  end;
  Grid.ColWidths[Column] := WMax + 5;
end;

procedure TForm_Shape.AutoSizeColumns(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to StrGrid_Profile.ColCount - 1 do
    AutoSizeCol(StrGrid_Profile, i);
end;

procedure TForm_Shape.StrGrid_ShapeDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  grid: TStringGrid;
  S: String;
  drawrect: TRect;
  bgFill: TColor;
begin
  grid := Sender as TStringGrid;

  if gdFixed in State then
    bgFill := $FFF8F8
  else
  if gdSelected in State then
    bgFill := $FFF0D0
  else
    bgFill := clWhite;

  grid.Canvas.Brush.Color := bgFill;
  grid.canvas.Brush.Style := bsSolid;
  grid.canvas.fillrect(Rect);

  S := grid.Cells[ACol, ARow];
  if Length(S) > 0 then
  begin
    drawrect := Rect;
    drawrect.Inflate(-4 , 0);
    DrawText(grid.canvas.handle, Pchar(S), Length(S), drawrect,
      dt_calcrect or dt_wordbreak or dt_left);
    If (drawrect.bottom - drawrect.top) > grid.RowHeights[ARow] then
      grid.RowHeights[ARow] := (drawrect.bottom - drawrect.top+2)
      // changing the row height fires the event again!
    else
    begin
      drawrect.Right := Rect.Right;

//      grid.canvas.fillrect(drawrect);
      DrawText(grid.canvas.handle, Pchar(S), Length(S), drawrect,
        dt_wordbreak or dt_left);
    end;
  end;

  if gdFocused in State then
    grid.Canvas.DrawFocusRect(Rect);
end;

end.
object Form_Shape: TForm_Shape
  Left = 1613
  Height = 600
  Top = 114
  Width = 960
  Caption = 'Профил оценка'
  ClientHeight = 600
  ClientWidth = 960
  Color = clBtnFace
  Font.CharSet = RUSSIAN_CHARSET
  Font.Color = clBlack
  Font.Height = -15
  Font.Name = 'Tahoma'
  Font.Pitch = fpVariable
  Font.Quality = fqDraft
  OnShow = FormShow
  Position = poOwnerFormCenter
  LCLVersion = '7.7'
  object StrGrid_Profile: TStringGrid
    Left = 0
    Height = 600
    Top = 0
    Width = 960
    Align = alClient
    ColCount = 4
    FixedCols = 0
    RowCount = 14
    TabOrder = 0
    ColWidths = (
      152
      200
      64
      462
    )
  end
end
Last edit: 2 months 2 weeks ago by Droid c3p0.

Please Log in or Create an account to join the conversation.

  • Matis A.
  • Matis A.'s Avatar
  • Away
  • Moderator
  • Moderator
More
2 months 2 weeks ago - 2 months 2 weeks ago #16826 by Matis A.
For test try
in procedure TForm_Shape.StrGrid_ShapeDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
to use :grid.canvas.Text....
Canvas text functions.

and NOT
DrawText(grid.canvas.handle, Pchar(S)....
functions
 
PS: You can simple ZIP or 7zip and attach the project file here

PilotLogic Core Programmer
Last edit: 2 months 2 weeks ago by Matis A..

Please Log in or Create an account to join the conversation.